VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "SnarlApp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Public Enum STATUS_CODE
    SUCCESS = 0

    ' /* critical errors */

    ERROR_FAILED = 101                '// miscellaneous failure
    ERROR_UNKNOWN_COMMAND             '// specified command not recognised
    ERROR_TIMED_OUT                   '// Snarl took too long to respond
    '//104
    '//105
    ERROR_BAD_SOCKET = 106            '// invalid socket (or some other socket-related error)
    ERROR_BAD_PACKET = 107            '// badly formed request
    '//108
    ERROR_ARG_MISSING = 109           '// required argument missing
    ERROR_SYSTEM                      '// internal system error

    ERROR_ACCESS_DENIED = 121         '// libsnarl only

    ' /* warnings */

    ERROR_NOT_RUNNING = 201           '// Snarl handling window not found
    ERROR_NOT_REGISTERED
    ERROR_ALREADY_REGISTERED          '// not used yet; sn41RegisterApp() returns existing token
    ERROR_CLASS_ALREADY_EXISTS        '// not used yet
    ERROR_CLASS_BLOCKED
    ERROR_CLASS_NOT_FOUND
    ERROR_NOTIFICATION_NOT_FOUND
    ERROR_FLOODING                    '// notification generated by same class within quantum
    ERROR_DO_NOT_DISTURB              '// DnD mode is in effect was not logged as missed
    ERROR_COULD_NOT_DISPLAY           '// not enough space on-screen to display notification
    ERROR_AUTH_FAILURE                '// password mismatch

End Enum

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long

Const CLASS_NAME = "libsnarl25_app_callback"

Private Type T_INFO
    ' /* set during SetTo() */
    Signature As String
    Title As String
    Icon As String
    Password As String
    Classes As Classes
    IsAppDaemon As Boolean
    ConfigTool As String
    Hint As String
    RemoteHost As String

End Type

Dim mInfo As T_INFO
Dim mhWnd As Long                       ' // if registered using Win api
Dim mMsg As Long
Dim mTokens As Collection

Dim WithEvents theSocket As CSocket
Attribute theSocket.VB_VarHelpID = -1

Dim mCache As Collection

Public Event NotificationInvoked(ByVal UID As String)
Public Event NotificationExpired(ByVal UID As String)
Public Event NotificationActionSelected(ByVal UID As String, ByVal Identifier As String)
Public Event NotificationClosed(ByVal UID As String)
Public Event ShowAbout()
Public Event ShowConfig()
Public Event Activated()
Public Event Quit()
Public Event SnarlQuit()
Public Event SnarlLaunched()
Public Event SnarlStarted()
Public Event SnarlStopped()
Public Event UserAway()
Public Event UserReturned()

Dim WithEvents theSimpleWindow As TSimpleNotificationWindow
Attribute theSimpleWindow.VB_VarHelpID = -1

Implements IWndProc

Private Sub Class_Initialize()

    Set mTokens = New Collection
    Set mCache = New Collection
    mInfo.Password = create_password()
    Randomize Timer
    mMsg = &H400 + (Rnd * 255)
    Debug.Print "SnarlApp.SetTo(): callback msg=0x" & g_HexStr(mMsg, 4)

    ' /* create our callback window */

    EZRegisterClass CLASS_NAME
    mhWnd = EZ4AddWindow(CLASS_NAME, Me)

    ' /* did window create ok? */

    If mhWnd = 0 Then _
        Debug.Print "SnarlApp.uRegisterLocal(): couldn't create callback window"

End Sub

Private Sub Class_Terminate()

    Debug.Print "SnarlApp.Terminate"

    Debug.Print "SnarlApp.Terminate complete"

End Sub

Public Property Get Signature() As String

    Signature = mInfo.Signature

End Property

Public Property Let Signature(ByVal vNewValue As String)

    mInfo.Signature = vNewValue

End Property

Public Property Get Title() As String

    Title = mInfo.Title

End Property

Public Property Let Title(ByVal vNewValue As String)

    mInfo.Title = vNewValue

End Property

Public Property Get Icon() As String

    Icon = mInfo.Icon

End Property

Public Property Let Icon(ByVal vNewValue As String)

    mInfo.Icon = vNewValue

End Property

Public Property Get Classes() As Classes

    Set Classes = mInfo.Classes

End Property

Public Property Let Classes(ByVal vNewValue As Classes)

    If NOTNULL(mInfo.Classes) Then _
        mInfo.Classes.bUnSet

    Set mInfo.Classes = vNewValue

    If NOTNULL(mInfo.Classes) Then _
        mInfo.Classes.bSet Me

End Property

Public Property Get RemoteComputer() As String

    RemoteComputer = mInfo.RemoteHost

End Property

Public Property Let RemoteComputer(ByVal vNewValue As String)

    mInfo.RemoteHost = vNewValue

End Property

Public Property Get ConfigTool() As String

    ConfigTool = mInfo.ConfigTool

End Property

Public Property Let ConfigTool(ByVal vNewValue As String)

    mInfo.ConfigTool = vNewValue

End Property

Public Property Get Hint() As String

    Hint = mInfo.Hint

End Property

Public Property Let Hint(ByVal vNewValue As String)

    mInfo.Hint = vNewValue

End Property

Public Property Get IsDaemon() As Boolean

    IsDaemon = mInfo.IsAppDaemon

End Property

Public Property Let IsDaemon(ByVal vNewValue As Boolean)

    mInfo.IsAppDaemon = vNewValue

End Property

Public Function Show(ByRef Notification As Notification) As STATUS_CODE

    If (Notification Is Nothing) Then
        Show = ERROR_ARG_MISSING
        Exit Function

    End If

    If NOTNULL(theSimpleWindow) Then
        theSimpleWindow.Quit
        Set theSimpleWindow = Nothing

    End If

Dim szReq As String
Dim hr As STATUS_CODE

    ' /* send locally (via Win32 API)? */

    If mInfo.RemoteHost = "" Then

        If Not Me.IsSnarlRunning Then
            Set theSimpleWindow = New TSimpleNotificationWindow
            If theSimpleWindow.Go(Notification) Then
                hr = SUCCESS

            Else
                hr = ERROR_NOT_RUNNING

            End If

        Else
            hr = uRegisterLocal()
            If hr >= SUCCESS Then
                ' /* registered ok */
                hr = snDoRequest(Notification.bAsRequest(mInfo.Signature, mInfo.Password))
                If hr > SUCCESS Then
                    uAddToken Notification, CStr(hr)
                    Debug.Print "SnarlApp.Show(): logged uid '" & Notification.UID & "' against token " & CStr(hr)
                    hr = SUCCESS
    
                Else
                    Debug.Print "SnarlApp.Show(): notify failed: " & CStr(hr)
    
                End If
    
            Else
                Debug.Print "SnarlApp.Show(): registration failed: " & CStr(hr)
        
            End If

        End If

        Show = Abs(hr)

    Else
        ' /* build the SNP3 request */

        szReq = "SNP/3.0" & vbCrLf & uAsRequest(False) & Notification.bAsRequest(mInfo.Signature, mInfo.Password) & vbCrLf & "END" & vbCrLf

        If Me.IsConnected() Then
            ' /* send to remote computer */
            Debug.Print "sending '" & Replace$(szReq, vbCrLf, "+") & "' to " & mInfo.RemoteHost & "..."
            theSocket.SendData szReq

        Else
            ' /* cache the request and initiate a connection to the remote computer */
            Debug.Print "caching '" & Replace$(szReq, vbCrLf, "+") & "' and connecting to " & mInfo.RemoteHost & "..."
            
            Do While mCache.Count > 0
                mCache.Remove 1

            Loop

            mCache.Add szReq

            Set theSocket = New CSocket
            theSocket.Connect mInfo.RemoteHost, 9887

        End If

    End If

End Function

Private Function uRegisterLocal() As STATUS_CODE

    ' /* return */

    If (mInfo.Signature = "") Or (mInfo.Title = "") Then
        Debug.Print "SnarlApp.uRegisterLocal(): invalid args"
        uRegisterLocal = ERROR_ARG_MISSING
        Exit Function

    End If

    uRegisterLocal = snDoRequest(uAsRequest(True))

    If uRegisterLocal < 0 Then _
        Exit Function

    ' /* success */

Dim i As Long

    If Not (mInfo.Classes Is Nothing) Then
        With mInfo.Classes
            If .Count Then
                Debug.Print "adding classes..."
                For i = 1 To .Count
                    snDoRequest .bAsRequest(i, mInfo.Signature, mInfo.Password)

                Next i

            Else
                Debug.Print "SnarlApp.uRegisterLocal(): warning - no classes defined"

            End If

        End With
    Else
        Debug.Print "SnarlApp.uRegisterLocal(): warning - no classes defined"

    End If

    Debug.Print "SnarlApp.uRegisterLocal(): ok"
    uRegisterLocal = SUCCESS

End Function

'Public Function DoRequest(ByVal Request As String, Optional ByVal ReplyTimeout As Long = 1000) As Long
'
''    If Not (theSocket Is Nothing) Then
'''        DoRequest = uSendSNP(Request)
''
''    Else
'        DoRequest = snDoRequest(Request, ReplyTimeout)
''
''    End If
'
'End Function

Public Function Hide(ByVal UID As String) As STATUS_CODE

    Hide = Abs(snDoRequest("hide?app-sig=" & mInfo.Signature & "&password=" & mInfo.Password & "&uid=" & UID))

End Function

Public Function IsSnarlRunning() As Boolean

    IsSnarlRunning = snIsSnarlRunning()

End Function

Public Function SnarlVersion() As Long

    SnarlVersion = snDoRequest("version")

End Function

Public Function GetEtcPath() As String
Dim sz As String

    If snGetConfigPath(sz) Then _
        GetEtcPath = sz

End Function

Public Function MakePath(ByVal Path As String) As String

    MakePath = g_MakePath(Path)

End Function

Private Function uAsRequest(ByVal ForLocalInstance As Boolean) As String
Dim sz As String

    sz = "register?app-sig=" & mInfo.Signature & "&password=" & mInfo.Password & "&title=" & mInfo.Title
    
    If ForLocalInstance Then _
        sz = sz & "&reply-to=" & CStr(mhWnd) & "&reply-with=" & CStr(mMsg)


    If mInfo.Icon <> "" Then _
        sz = sz & "&icon=" & mInfo.Icon

    If mInfo.ConfigTool <> "" Then _
        sz = sz & "&config-tool=" & mInfo.ConfigTool
    
    If mInfo.Hint <> "" Then _
        sz = sz & "&hint=" & mInfo.Hint

    If (mInfo.IsAppDaemon) And (ForLocalInstance) Then _
        sz = sz & "&app-daemon=1"


Dim i As Long

    ' /* if this is for an SNP3 request, add in the classes as well */

    If Not ForLocalInstance Then
        sz = sz & vbCrLf
        If Not (mInfo.Classes Is Nothing) Then
            With mInfo.Classes
                If .Count Then
                    For i = 1 To .Count
                        sz = sz & .bAsRequest(i, mInfo.Signature, mInfo.Password) & vbCrLf
                        
                    Next i

                End If
            End With
        End If
    End If

    uAsRequest = sz

End Function

Friend Function bPassword() As String

    bPassword = mInfo.Password

End Function

Private Sub uAddToken(ByRef pn As Notification, ByVal Key As String)

    On Error Resume Next
    mTokens.Add pn, Key

End Sub

'Public Sub TidyUp()
'Dim pr As TSNP3Req
'Dim i As Long
'
'    ' /* unregister remotely */
'
''    If Not (mInfo.Destinations Is Nothing) Then
''        With mInfo.Destinations
''            If .Count Then
''                For i = 1 To .Count
''                    Set pr = New TSNP3Req
''                    pr.SendData "unregister?app-sig=" & mInfo.Signature & "&password=" & mInfo.Password, .bDestination(i)
''                    mSNP3Requests.Add pr, pr.Guid
''
''                Next i
''
'''                i = GetTickCount()
'''                Do While (GetTickCount() - i) < 10000
'''                    DoEvents
'''                    Sleep 1
'''
'''                Loop
''
''            End If
''        End With
''    End If
'
'End Sub

Public Property Get IsConnected() As Boolean

    If mInfo.RemoteHost = "" Then
        ' /* using API */
        IsConnected = snIsSnarlRunning()

    ElseIf NOTNULL(theSocket) Then
        IsConnected = (theSocket.State = sckConnected)

    End If

End Property

Public Property Get LibVersion() As Integer

    LibVersion = App.Major

End Property

Public Property Get LibRevision() As Integer

    LibRevision = App.Minor

End Property

Private Function IWndProc_WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal PrevWndProc As Long, ReturnValue As Long) As Boolean
Dim pn As Notification

    On Error Resume Next

    Select Case uMsg
    Case snSysMsg()
    
        Debug.Print "system message " & wParam
    
        Select Case wParam
        Case SNARL_BROADCAST_LAUNCHED
            RaiseEvent SnarlLaunched

        Case SNARL_BROADCAST_QUIT
            RaiseEvent SnarlQuit

        Case SNARL_BROADCAST_STARTED
            RaiseEvent SnarlStarted

        Case SNARL_BROADCAST_STOPPED
            RaiseEvent SnarlStopped

'        Case SNARL_BROADCAST_USER_AWAY
'            RaiseEvent UserAway
'
'        Case SNARL_BROADCAST_USER_BACK
'            RaiseEvent UserReturned

        End Select

    Case snAppMsg()
        Select Case wParam
        Case SNARLAPP_DO_ABOUT
            RaiseEvent ShowAbout

        Case SNARLAPP_DO_PREFS
            RaiseEvent ShowConfig

        Case SNARLAPP_ACTIVATED
            RaiseEvent Activated

        Case SNARLAPP_QUIT_REQUESTED
            RaiseEvent Quit

        End Select

    Case mMsg

        Set pn = mTokens.Item(CStr(lParam))

        Select Case LoWord(wParam)
        Case SNARL_CALLBACK_MENU_SELECTED
            Debug.Print "menu selected"
'            RaiseEvent MenuSelected(lParam, HiWord(wParam))

        Case SNARL_CALLBACK_M_CLICK
            Debug.Print "middle button"

        Case SNARL_CALLBACK_INVOKED
            If NOTNULL(pn) Then _
                RaiseEvent NotificationInvoked(pn.UID)

        Case SNARL_CALLBACK_R_CLICK
            Debug.Print "right click"

        Case SNARL_CALLBACK_TIMED_OUT
            If NOTNULL(pn) Then _
                RaiseEvent NotificationExpired(pn.UID)

        Case SNARL_NOTIFY_ACTION
            If NOTNULL(pn) Then
                Debug.Print "action '" & CStr(HiWord(wParam)) & "' (" & pn.Actions.bLookUp(HiWord(wParam)) & ") from " & pn.UID
                RaiseEvent NotificationActionSelected(pn.UID, pn.Actions.bLookUp(HiWord(wParam)))

            End If

            Exit Function

        Case SNARL_NOTIFY_CLOSED, SNARL_CALLBACK_CLOSED
            If NOTNULL(pn) Then _
                RaiseEvent NotificationClosed(pn.UID)

        Case SNARL_BROADCAST_USER_AWAY
            RaiseEvent UserAway
        
        Case SNARL_BROADCAST_USER_BACK
            RaiseEvent UserReturned

        Case Else
            Debug.Print g_HexStr(wParam)

        End Select

        mTokens.Remove CStr(lParam)

    End Select

End Function

Private Sub theSimpleWindow_Clicked(ByVal UID As String)

    RaiseEvent NotificationInvoked(UID)
    Set theSimpleWindow = Nothing

End Sub

Private Sub theSimpleWindow_TimedOut(ByVal UID As String)

    RaiseEvent NotificationExpired(UID)
    Set theSimpleWindow = Nothing

End Sub

Private Sub theSocket_OnClose()

    Debug.Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
    Debug.Print "!! Snarl dropped connection !!"
    Debug.Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"

    theSocket.CloseSocket
    Set theSocket = Nothing         ' // will try to connect on next Show()

End Sub

Private Sub theSocket_OnConnect()
Dim i As Long
Dim c As Long

    Debug.Print "SnarlApp.OnConnect(): now connected to " & theSocket.RemoteHost

    c = mCache.Count
    If c > 0 Then
        For i = 1 To c
            Debug.Print "SnarlApp.OnConnect(): sending '" & mCache.Item(1) & "'..."
            theSocket.SendData mCache.Item(1)
            mCache.Remove 1

        Next i

    End If

End Sub

Public Function IsSnarlInstalled() As Boolean
Dim hKey As Long
Dim sz As String

    If reg_OpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\Snarl.exe", hKey) Then
        If reg_GetValue(hKey, "", sz) Then _
            IsSnarlInstalled = g_Exists(sz)

        Debug.Print "IsSnarlInstalled: '" & sz & "': " & IsSnarlInstalled

    End If

End Function

Public Function Register() As STATUS_CODE
Dim szReq As String

    If mInfo.RemoteHost = "" Then
        ' /* local */
        Register = Abs(uRegisterLocal())

    Else
        ' /* build the SNP3 request */
        szReq = "SNP/3.0" & vbCrLf & uAsRequest(False) & "END" & vbCrLf
        If NOTNULL(theSocket) Then
            ' /* send to remote computer */
            Debug.Print "sending '" & Replace$(szReq, vbCrLf, "+") & "' to " & mInfo.RemoteHost & "..."
            theSocket.SendData szReq

        Else
            ' /* cache the request and initiate a connection to the remote computer */
            mCache.Add szReq
            Set theSocket = New CSocket
            theSocket.Connect mInfo.RemoteHost, 9887

        End If
    End If

End Function

Public Function Unregister() As STATUS_CODE
Dim hr As STATUS_CODE

    If mInfo.Signature <> "" Then
        If mInfo.RemoteHost = "" Then
            ' /* unregister locally */
            Debug.Print "SnarlApp.TidyUp(): local"
            Unregister = snDoRequest("unreg?app-sig=" & mInfo.Signature & "&password=" & mInfo.Password)

        ElseIf Me.IsConnected() Then
            Debug.Print "SnarlApp.TidyUp(): connected"
            theSocket.SendData "SNP/3.0" & vbCrLf & "unregister?app-sig=" & mInfo.Signature & "&password=" & mInfo.Password & vbCrLf & "END" & vbCrLf
            Unregister = SUCCESS

        Else
            Debug.Print "SnarlApp.TidyUp(): not connected"
            Unregister = ERROR_BAD_SOCKET

        End If

    Else
        Unregister = ERROR_FAILED

    End If

End Function

Public Sub TidyUp()

    Unregister

    Me.Classes = Nothing                    ' // should release our handle from the Classes object

    If mhWnd <> 0 Then
        EZ4RemoveWindow mhWnd
        EZUnregisterClass CLASS_NAME

    End If

    If NOTNULL(theSimpleWindow) Then
        theSimpleWindow.Quit
        Set theSimpleWindow = Nothing

    End If

End Sub

Public Function IsVisible(ByVal UID As String) As STATUS_CODE

    IsVisible = Abs(snDoRequest("isvisible?app-sig=" & mInfo.Signature & "&password=" & mInfo.Password & "&uid=" & UID))

End Function

Friend Sub bRemoveClass(ByVal Name As String)
Dim hr As STATUS_CODE

    hr = Me.bDoRequest("remclass?app-sig=" & mInfo.Signature & "&password=" & mInfo.Password & "&id=" & Name)
    Debug.Print "SnarlApp.bRemoveClass(): '" & Name & "': " & CStr(Abs(hr))

End Sub

Friend Function bDoRequest(ByVal Request As String) As SNARL_STATUS_CODE

    If mInfo.RemoteHost = "" Then
        ' /* send using Win32 API */
        bDoRequest = snDoRequest(Request)

    Else
        ' /* build the SNP3 request */

        Request = "SNP/3.0" & vbCrLf & _
                  Request & vbCrLf & _
                  "END" & vbCrLf

        If Me.IsConnected() Then
            ' /* send to remote computer */
            Debug.Print "sending '" & Replace$(Request, vbCrLf, "+") & "' to " & mInfo.RemoteHost & "..."
            theSocket.SendData Request

        Else
            ' /* cache the request and initiate a connection to the remote computer */
            Debug.Print "caching '" & Replace$(Request, vbCrLf, "+") & "' and connecting to " & mInfo.RemoteHost & "..."

            Do While mCache.Count > 0
                mCache.Remove 1

            Loop

            mCache.Add Request

            Set theSocket = New CSocket
            theSocket.Connect mInfo.RemoteHost, 9887

        End If
    End If

End Function
